home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacHaskell 2.2 / progs / lib / hbc / Pretty.hs < prev    next >
Encoding:
Text File  |  1994-09-27  |  1.2 KB  |  51 lines  |  [TEXT/YHS2]
  1. module Pretty(text, separate, nest, pretty, (~.), (^.), IText(..), Context(..)) where
  2. infixr 8 ~.
  3. infixr 8 ^.
  4.  
  5. type IText   = Context -> [String]
  6. type Context = (Bool,Int,Int,Int)
  7.  
  8. text :: String -> IText
  9. text s (v,w,m,m') = [s]
  10.  
  11. (~.) :: IText -> IText -> IText
  12. (~.) d1 d2 (v,w,m,m') =
  13.     let t = d1 (False,w,m,m')
  14.             tn = last t
  15.         indent = length tn
  16.         sig = if length t == 1
  17.           then m' + indent
  18.           else length (dropWhile (==' ') tn)
  19.         (l:ls) = d2 (False,w-indent,m,sig)
  20.     in  init t ++
  21.         [tn ++ l] ++
  22.         map (space indent++) ls
  23.  
  24. space :: Int -> String
  25. space n = [' ' | i<-[1..n]]
  26.  
  27. (^.) :: IText -> IText -> IText
  28. (^.) d1 d2 (v,w,m,m') = d1 (True,w,m,m') ++ d2 (True,w,m,0)
  29.  
  30. separate :: [IText] -> IText
  31. separate [] _ = [""]
  32. separate ds (v,w,m,m') = 
  33.     let hor = foldr1 (\d1 d2 -> d1 ~. text " " ~. d2) ds
  34.         ver = foldr1 (^.) ds
  35.         t = hor (v,w,m,m')
  36.     in  if fits 1 t && fits (w `min` m-m') (head t)
  37.         then t
  38.         else ver (v,w,m,m')
  39.  
  40. fits n xs = length xs <= n `max` 0 --null (drop n xs)
  41.  
  42. nest :: Int -> IText -> IText
  43. nest n d (v,w,m,m') = 
  44.     if v then
  45.         map (space n++) (d (v,w-n,m,if m'==0 then 0 else m'+n)) 
  46.     else 
  47.         d (v,w,m,m')
  48.  
  49. pretty :: Int->Int->IText->String
  50. pretty w m d = concat (map (++"\n") (d (False,w,m,0)))
  51.